home *** CD-ROM | disk | FTP | other *** search
- /***************************************************************************
- * Ce fichier, ainsi que tous les modules l'accompagnant, peut et doit *
- * etre copié GRATUITEMENT à la seule condition expresse de conserver *
- * l'INTEGRALITE du Code Source, de la documentation, et des fichiers *
- * annexes du package. Ce logiciel est Shareware, veuilez envoyer 100 FF à *
- * l'auteur pour recevoir regulièrement les nouvelles versions. *
- * Toute modification est INTERDITE sans l'autorisation écrite de l'auteur. *
- * Tous droits réservés à M. DIALLO Barrou, Juillet 1992. *
- ***************************************************************************/
-
- /*************** Librarie de fonctions Pascal *****************/
-
- #ifdef msdos
- #include "include\\cleobis.h"
- #include "include\\libs.h"
- #else
- #include "include/cleobis.h"
- #include "include/libs.h"
- #endif
-
- extern void TraitErreur (char type, int num, int lig, int col);
- extern int curlg;
- extern int curcol;
- extern char curtoken[];
- extern CONST *symb;
- extern CONST *cursymb;
- extern VAR *var;
- extern VAR *curvar;
- extern int NbVar;
- extern MY_TYPESID curtokentype;
- extern MY_TYPESID lasttokentype;
- extern MY_TYPESID facttype;
- extern MY_CONST curconst;
- extern Entete head;
- extern int curtokenid;
- extern int lasttokenid;
- extern int curadr;
- extern long AdressSize;
- extern int *Adress;
- extern int pcpc;
- extern FIELDSTRUCT Field[];
-
- void NewAdress(void)
- {
- if (curadr == AdressSize)
- TraitErreur(FATALERROR, NOADRSPC, curlg, curcol);
- else
- curadr++;
- }
-
- void while_fct(void)
- {
- int adress, adress1;
-
- NewAdress();
- adress = curadr;
- Code (ORG, adress); /* Stocke l'adr du debut du while */
- Lexical();
- Expr();
- NewAdress();
- adress1 = curadr;
- Code ( BNE, adress1);
- if ( curtokenid == do_f)
- {
- Lexical();
- Instruction();
- Code ( BRA, adress);
- Code (ORG, adress1); /* La fin du while (adress1)
- est egal au PC apres l'instruction */
- }
- else
- TraitErreur(TEXTERROR, NODO, curlg, curcol);
- }
-
- void for_fct(void)
- {
- int adress;
- NewAdress();
- adress = curadr;
- Code (ORG, adress);
- Lexical();
-
- }
-
- void repeat_fct(void)
- {
- int adress;
-
- NewAdress();
- adress = curadr;
- Code (ORG, adress);
- do {
- Lexical();
- Instruction();
- } while ( *curtoken == ';');
-
- if (curtokenid != until_f)
- TraitErreur (TEXTERROR, NOUNTIL, curlg, curcol);
- else
- {
- Lexical();
- Expr();
- }
- Code( BNE, adress);
- }
-
- void PokeAdr(int adress)
- {
- Adress[adress] = pcpc;
- }
-
- void if_fct(void)
- {
- int adress1, adress;
-
- Lexical();
- Expr();
- NewAdress();
- adress = curadr;
- Code ( BNE, adress);
- if (curtokenid != then_f)
- TraitErreur (TEXTERROR, NOTHEN, curlg, curcol);
- else
- {
- Lexical();
- Instruction();
-
- if ( *curtoken == ';') PokeAdr( adress);
- else
- {
- if ( curtokenid == else_f)
- {
- NewAdress();
- adress1 = curadr;
- Code ( BRA, adress1);
- Code (ORG, adress);
- Lexical();
- Instruction();
- Code ( ORG, adress1);
- }
- else
- printf("ELSE Manquant...\n");
- }
- }
- }
-
- void read_fct(void)
- {
- if ( *curtoken != '(' )
- TraitErreur ( TEXTERROR, NOPO, curlg, curcol);
- else
- do {
- Lexical();
- if ( curtokentype != ident_mt)
- TraitErreur (TEXTERROR, NOIDENT, curlg, curcol);
- else
- {
- TestVar(FALSE);
- Code (READ, 0);
- }
- } while ( *curtoken == ',');
-
- if ( *curtoken != ')' )
- TraitErreur (TEXTERROR, NOPF, curlg, curcol);
- else
- Lexical();
- }
-
- void readln_fct(void)
- {
- Lexical();
- if ( *curtoken == '(' )
- read_fct();
- Code ( CHR13, 0);
- }
-
- void writeln_fct (void)
- {
- Lexical();
- if ( *curtoken == '(' )
- write_fct();
- Code( CHR13, 0);
- }
-
- void write_fct(void)
- {
- if ( *curtoken != '(' )
- TraitErreur (TEXTERROR, NOPO, curlg, curcol);
- else
- {
- do {
- Lexical();
- if ( curtokentype == constchr_mt || curtokentype == conststr_mt )
- {
- InsConst();
- if (lasttokentype == constchr_mt)
- {
- Code ( PRCHR, 0); /* print la const chr sur la pile */
- }
- else
- {
- Code ( PRSTR,0); /* print la String sur la pile */
- }
- }
- else
- {
- Simple_Exp();
- /*** ATTENTION, on ne connait pas le type de la valeur !!!!! */
- if (facttype == string_t)
- Code ( PRVSTR, 0);
- else
- if (facttype == char_t)
- Code ( PRINTCHR, 0);
- else
- Code ( PRINT, 0); /* affiche la valeur sur la pile */
- }
- } while ( *curtoken == ',' );
-
- if ( *curtoken != ')' )
- TraitErreur ( TEXTERROR, NOPF, curlg, curcol);
- else
- Lexical();
- }
- }
-